home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 21 / AACD 21.iso / AACD / Programming / amigatalk / intuition / Gadget.st < prev    next >
Encoding:
Text File  |  2000-05-03  |  10.7 KB  |  386 lines
  1. "------------------------------------------------------------------"
  2. " Gadget Class is an abstract class.  The user has to use the other"
  3. " classes in this file for concrete Amiga Gadgets.                 "
  4. "------------------------------------------------------------------"
  5.  
  6. Class Gadget :Glyph
  7. ! gadgetType gadgetName !
  8. [
  9.    gadgetTypeIs
  10.       gadgetType <- <primitive 183 2 0 6 gadgetName>.
  11.       (gadgetType == nil)    "NOT a BoolGadget, Check some more:"
  12.          ifTrue: [gadgetType <- <primitive 183 2 1 6 gadgetName>.
  13.                   (gadgetType == nil)    "Has to be a PropGadget:"
  14.                    ifTrue: [gadgetType <- <primitive 183 2 2 6 gadgetName>]
  15.                  ].
  16.       ^ gadgetType
  17. |
  18.    gadgetNameIs
  19.       ^ gadgetName
  20. |
  21.    new: newGadgetName
  22.       <primitive 183 1 0 newGadgetName>.
  23.       gadgetName <- newGadgetName.
  24.       ^ self
  25. ]
  26.  
  27. "-----------------------------------------------------------------------"
  28. " BoolGadget Class implements messages specific only to boolean gadgets."
  29. "-----------------------------------------------------------------------"
  30.  
  31. Class BoolGadget :Gadget
  32. ! 
  33.    leftEdge topEdge width height flags activation gadgetType gadgetID
  34.    iTextName nextGadgetName renderName selectName gadgetName
  35. !
  36. [
  37.    new: newGadgetName
  38.       super    new: newGadgetName.
  39.       gadgetName <- super gadgetNameIs.
  40.       ^ self
  41. |
  42.    remove
  43.       <primitive 183 0 0 gadgetName>
  44. |
  45.    registerTo: windowTitle
  46.       <primitive 183 7 0 windowTitle gadgetName>
  47. |
  48.    setStartPoint: newPoint ! x y !  "newPoint  is leftEdge @ topEdge"
  49.       x <- newPoint x.
  50.       y <- newPoint y.
  51.       <primitive 183 3 0 0 x gadgetName>.
  52.       <primitive 183 3 0 1 y gadgetName>.
  53.       leftEdge <- x.
  54.       topEdge  <- y
  55. |   
  56.    setGadgetSizeTo: sizePoint ! w h ! "sizePoint is width @ height"
  57.       w <- sizePoint x.
  58.       h <- sizePoint y.
  59.       <primitive 183 3 0 2 w gadgetName>.
  60.       <primitive 183 3 0 3 h gadgetName>.
  61.       width  <- w.
  62.       height <- h
  63. |
  64.    getStartPoint
  65.       leftEdge <- <primitive 183 2 0 0 gadgetName>.
  66.       topEdge  <- <primitive 183 2 0 1 gadgetName>.
  67.       ^ leftEdge @ topEdge
  68. |
  69.    getGadgetSize
  70.       width  <- <primitive 183 2 0 2 gadgetName>.
  71.       height <- <primitive 183 2 0 3 gadgetName>.
  72.       ^ width @ height
  73. |
  74.    getFlags
  75.       ^ flags <- <primitive 183 2 0 4 gadgetName>
  76. |
  77.    setFlags: newFlags
  78.       <primitive 183 3 0 4 newFlags gadgetName>.
  79.       flags <- newFlags
  80. |
  81.    getActivation
  82.       ^ activation <- <primitive 183 2 0 5 gadgetName>
  83. |
  84.    setActivation: newActivation
  85.       <primitive 183 3 0 5 newActivation gadgetName>.
  86.       activation <- newActivation
  87. |
  88.    "only needed because of GZZGADGET & REQGADGET type flags."
  89.    getGadgetType
  90.       ^ gadgetType <- <primitive 183 2 0 6 gadgetName>
  91. |
  92.    "only needed because of GZZGADGET & REQGADGET type flags."
  93.    setGadgetType: newGadgetType
  94.       <primitive 183 3 0 6 newGadgetType gadgetName>.
  95.       gadgetType <- newGadgetType
  96. |
  97.    getGadgetID
  98.       ^ gadgetID <- <primitive 183 2 0 7 gadgetName>
  99. |
  100.    setGadgetID: newGadgetID
  101.       <primitive 183 3 0 7 newGadgetID gadgetName>.
  102.       gadgetID <- newGadgetID
  103. |
  104.    getNextGadgetName
  105.       ^ nextGadgetName <- <primitive 183 2 0 8 gadgetName>
  106. |
  107.    setNextGadgetName: newNextGadgetName
  108.       <primitive 183 3 0 8 newNextGadgetName gadgetName>.
  109.       nextGadgetName <- newNextGadgetName
  110. |
  111.    getITextName
  112.       ^ iTextName <- <primitive 183 2 0 9 gadgetName>
  113. |
  114.    setITextName: newITextName
  115.       <primitive 183 3 0 9 newITextName gadgetName>.
  116.       iTextName <- newITextName
  117. |
  118.    getRenderName
  119.       ^ renderName <- <primitive 183 2 0 10 gadgetName>
  120. |
  121.    setRenderName: newRenderName
  122.       <primitive 183 3 0 10 newRenderName gadgetName>.
  123.       renderName <- newRenderName
  124. |
  125.    getSelectName
  126.       ^ selectName <- <primitive 183 2 0 11 gadgetName>
  127. |
  128.    setSelectName: newSelectName
  129.       <primitive 183 3 0 11 newSelectName gadgetName>.
  130.       selectName <- newSelectName
  131. ]
  132.  
  133. "---------------------------------------------------------------------"
  134. " StrGadget Class implements messages specific only to string gadgets."
  135. "---------------------------------------------------------------------"
  136.  
  137. Class StrGadget :Gadget
  138. ! 
  139.    leftEdge topEdge width height flags activation gadgetType gadgetID
  140.    iTextName nextGadgetName renderName selectName bufferSize gadgetName
  141. !
  142. [
  143.    changeBufferSize: newSize
  144.       <primitive 183 5 newSize gadgetName>.
  145.       bufferSize <- newSize
  146. |
  147.    getBufferSize
  148.       ^ bufferSize <- <primitive 183 2 1 12 gadgetName>
  149. |
  150.    remove
  151.       <primitive 183 0 1 gadgetName>
  152. |
  153.    registerTo: windowTitle
  154.       <primitive 183 7 1 windowTitle gadgetName>
  155. |
  156.    setStartPoint: newPoint ! x y !
  157.       x <- newPoint x.
  158.       y <- newPoint y.
  159.       <primitive 183 3 1 0 x gadgetName>.
  160.       <primitive 183 3 1 1 y gadgetName>.
  161.       leftEdge <- x.
  162.       topEdge  <- y
  163. |   
  164.    setGadgetSize: sizePoint ! w h !
  165.       w <- sizePoint x.
  166.       h <- sizePoint y. 
  167.       <primitive 183 3 1 2 w gadgetName>.
  168.       <primitive 183 3 1 3 h gadgetName>.
  169.       width  <- w.
  170.       height <- h
  171. |
  172.    getStartPoint
  173.       leftEdge <- <primitive 183 2 1 0 gadgetName>.
  174.       topEdge  <- <primitive 183 2 1 1 gadgetName>.
  175.       ^ leftEdge @ topEdge
  176. |
  177.    getGadgetSize
  178.       width  <- <primitive 183 2 1 2 gadgetName>.
  179.       height <- <primitive 183 2 1 3 gadgetName>.
  180.       ^ width @ height
  181. |
  182.    getFlags
  183.       ^ flags <- <primitive 183 2 1 4 gadgetName>
  184. |
  185.    setFlags: newFlags
  186.       <primitive 183 3 1 4 newFlags gadgetName>.
  187.       flags <- newFlags
  188. |
  189.    getActivation
  190.       ^ activation <- <primitive 183 2 1 5 gadgetName>
  191. |
  192.    setActivation: newActivation
  193.       <primitive 183 3 1 5 newActivation gadgetName>.
  194.       activation <- newActivation
  195. |
  196.    "only needed because of GZZGADGET & REQGADGET type flags."
  197.    getGadgetType
  198.       ^ gadgetType <- <primitive 183 2 1 6 gadgetName>
  199. |
  200.    setGadgetType: newGadgetType
  201.       <primitive 183 3 1 6 newGadgetType gadgetName>.
  202.       gadgetType <- newGadgetType
  203. |
  204.    getGadgetID
  205.       ^ gadgetID <- <primitive 183 2 1 7 gadgetName>
  206. |
  207.    setGadgetID: newGadgetID
  208.       <primitive 183 3 1 7 newGadgetID gadgetName>.
  209.       gadgetID <- newGadgetID
  210. |
  211.    getNextGadgetName
  212.       ^ nextGadgetName <- <primitive 183 2 1 8 gadgetName>
  213. |
  214.    setNextGadgetName: newNextGadgetName
  215.       <primitive 183 3 1 8 newNextGadgetName gadgetName>.
  216.       nextGadgetName <- newNextGadgetName
  217. |
  218.    getITextName
  219.       ^ iTextName <- <primitive 183 2 1 9 gadgetName>
  220. |
  221.    setITextName: newITextName
  222.       <primitive 183 3 1 9 newITextName gadgetName>.
  223.       iTextName <- newITextName
  224. |
  225.    getRenderName
  226.       ^ renderName <- <primitive 183 2 1 10 gadgetName>
  227. |
  228.    setRenderName: newRenderName
  229.       <primitive 183 3 1 10 newRenderName gadgetName>.
  230.       renderName <- newRenderName
  231. |
  232.    getSelectName
  233.       ^ selectName <- <primitive 183 2 1 11 gadgetName>
  234. |
  235.    setSelectName: newSelectName
  236.       <primitive 183 3 1 11 newSelectName gadgetName>.
  237.       selectName <- newSelectName
  238. |
  239.    new: newGadgetName
  240.       super    new: newGadgetName.
  241.       gadgetName <- super gadgetNameIs.
  242.       self setGadgetType: 1.
  243.       ^ self
  244. ]
  245.  
  246. "------------------------------------------------------"
  247. " PropGadget Class implements messages specific only to"
  248. " proportional gadgets.                                "
  249. "------------------------------------------------------"
  250.  
  251. Class PropGadget :Gadget
  252. ! 
  253.    leftEdge topEdge width height flags activation gadgetType gadgetID
  254.    iTextName nextGadgetName renderName selectName propFlags  hPot
  255.    vPot      hBody          vBody      gadgetName
  256. !
  257. [
  258.    modifyProps: newFlags hPot: hp vPot: vp hBody: hb
  259.                 vBody: vb windowName: windowTitle
  260.       <primitive 183 4 newFlags hp vp hb vb windowTitle gadgetName>.
  261.       flags <- newFlags.
  262.       hPot  <- hp.
  263.       vPot  <- vp.
  264.       hBody <- hb.
  265.       vBody <- vb
  266. |
  267.    setProps: newFlags hPot: hp vPot: vp hBody: hb vBody: vb
  268.       <primitive 183 6 newFlags hp vp hb vb gadgetName>.
  269.       flags <- newFlags.
  270.       hPot  <- hp.
  271.       vPot  <- vp.
  272.       hBody <- hb.
  273.       vBody <- vb
  274. |
  275.    remove
  276.       <primitive 183 0 2 gadgetName>
  277. |
  278.    registerTo: windowTitle
  279.       <primitive 183 7 2 windowTitle gadgetName>
  280. |
  281.    setStartPoint: newPoint ! x y !
  282.       x <- newPoint x.
  283.       y <- newPoint y.
  284.       <primitive 183 3 2 0 x gadgetName>.
  285.       <primitive 183 3 2 1 y gadgetName>.
  286.       leftEdge <- x.
  287.       topEdge  <- y
  288. |   
  289.    setGadgetSize: sizePoint ! w h !
  290.       w <- sizePoint x.
  291.       h <- sizePoint y.
  292.       <primitive 183 3 2 2 w gadgetName>.
  293.       <primitive 183 3 2 3 h gadgetName>.
  294.       width  <- w.
  295.       height <- h
  296. |
  297.    getStartPoint
  298.       leftEdge <- <primitive 183 2 2 0 gadgetName>.
  299.       topEdge  <- <primitive 183 2 2 1 gadgetName>.
  300.       ^ leftEdge @ topEdge
  301. |
  302.    getGadgetSize
  303.       width  <- <primitive 183 2 2 2 gadgetName>.
  304.       height <- <primitive 183 2 2 3 gadgetName>.
  305.       ^ width @ height
  306. |
  307.    getFlags
  308.       ^ flags <- <primitive 183 2 2 4 gadgetName>
  309. |
  310.    setFlags: newFlags
  311.       <primitive 183 3 2 4 newFlags gadgetName>.
  312.       flags <- newFlags
  313. |
  314.    getActivation
  315.       ^ activation <- <primitive 183 2 2 5 gadgetName>
  316. |
  317.    setActivation: newActivation
  318.       <primitive 183 3 2 5 newActivation gadgetName>.
  319.       activation <- newActivation
  320. |
  321.    "only needed because of GZZGADGET & REQGADGET type flags."
  322.    getGadgetType
  323.       ^ gadgetType <- <primitive 183 2 2 6 gadgetName>
  324. |
  325.    "only needed because of GZZGADGET & REQGADGET type flags."
  326.    setGadgetType: newGadgetType
  327.       <primitive 183 3 2 6 newGadgetType gadgetName>.
  328.       gadgetType <- newGadgetType
  329. |
  330.    getGadgetID
  331.       ^ gadgetID <- <primitive 183 2 2 7 gadgetName>
  332. |
  333.    setGadgetID: newGadgetID
  334.       <primitive 183 3 2 7 newGadgetID gadgetName>.
  335.       gadgetID <- newGadgetID
  336. |
  337.    getNextGadgetName
  338.       ^ nextGadgetName <- <primitive 183 2 2 8 gadgetName>
  339. |
  340.    setNextGadgetName: newNextGadgetName
  341.       <primitive 183 3 2 8 newNextGadgetName gadgetName>.
  342.       nextGadgetName <- newNextGadgetName
  343. |
  344.    getITextName
  345.       ^ iTextName <- <primitive 183 2 2 9 gadgetName>
  346. |
  347.    setITextName: newITextName
  348.       <primitive 183 3 2 9 newITextName gadgetName>.
  349.       iTextName <- newITextName
  350. |
  351.    getRenderName
  352.       ^ renderName <- <primitive 183 2 2 10 gadgetName>
  353. |
  354.    setRenderName: newRenderName
  355.       <primitive 183 3 2 10 newRenderName gadgetName>.
  356.       renderName <- newRenderName
  357. |
  358.    getSelectName
  359.       ^ selectName <- <primitive 183 2 2 11 gadgetName>
  360. |
  361.    setSelectName: newSelectName
  362.       <primitive 183 3 2 11 newSelectName gadgetName>.
  363.       selectName <- newSelectName
  364. |
  365.    getPropFlags
  366.       ^ propFlags <- <primitive 183 2 2 13 gadgetName>
  367. |
  368.    getHPot
  369.       ^ hPot <- <primitive 183 2 2 14 gadgetName>
  370. |
  371.    getVPot
  372.       ^ vPot <- <primitive 183 2 2 15 gadgetName>
  373. |
  374.    getHBody
  375.       ^ hBody <- <primitive 183 2 2 16 gadgetName>
  376. |
  377.    getVBody
  378.       ^ vBody <- <primitive 183 2 2 17 gadgetName>
  379. |
  380.    new: newGadgetName
  381.       super    new: newGadgetName.
  382.       gadgetName <- super gadgetNameIs.
  383.       self setGadgetType: 2.
  384.       ^ self
  385. ]
  386.